home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / xlib.lha / xlib / clear.t < prev    next >
Text File  |  1990-05-31  |  2KB  |  61 lines
  1. ;;;    Creates a clear window which covers the display.  Then writes speckles
  2. ;;;    in it.  A mouse click causes it to go away.
  3.  
  4. (herald clear)
  5.  
  6. (define rand (make-random 5))
  7.  
  8. (define (random)
  9.     (quotient (rand) 4096))
  10.  
  11. (define (CLEAR display-name)
  12.     (let* ((dpy (let ((x (xopendisplay display-name)))
  13.              (if (null-pointer? x)
  14.              (error 'hello-world "DISPLAY is not defined"))
  15.              x))
  16.        (screen (xdefaultscreen dpy))
  17.        (attributes (let ((x (make-xsetwindowattributes)))
  18.                 (xsetwindowattributes-override_redirect! x 1)
  19.                 (xsetwindowattributes-background_pixmap! x none)
  20.                 x))
  21.        (height (xdisplayheight dpy screen))
  22.        (width (xdisplaywidth dpy screen))
  23.        (window (xcreatewindow dpy (xdefaultrootwindow dpy) 0 0
  24.                width height
  25.                0 copyfromparent copyfromparent
  26.                (type/value->pointer 'visualp copyfromparent)
  27.                (+ cwbackpixmap cwoverrideredirect)
  28.                attributes))
  29.        (gc (xcreategc dpy window 0 (make-xgcvalues)))
  30.        (event (make-xevent))
  31.        (old-reset reset))
  32.  
  33.       (set reset (lambda ()
  34.                   (xclosedisplay dpy)
  35.                   (set reset old-reset)
  36.                   (reset)))
  37.       (xsetforeground dpy gc (xblackpixel dpy screen))
  38.       (xselectinput dpy window (+ buttonpressmask exposuremask))
  39.       (xmapraised dpy window)
  40.       (iterate loop ()
  41.            (ynextevent dpy event)
  42.            (cond ((eq? (xevent-type event) expose)
  43.               (iterate loop ()
  44.                (xfillrectangle dpy window gc
  45.                    (remainder (random) width)
  46.                    (remainder (random) height) 1 1)
  47.                (if (eq? (xeventsqueued dpy queuedafterflush) 0)
  48.                    (loop)))
  49.               (loop))
  50.              ((eq? (xevent-type event) buttonpress)
  51.               (set reset old-reset)
  52.               (xfreegc dpy gc)
  53.               (xdestroywindow dpy window)
  54.               (xclosedisplay dpy))
  55.              (else (loop))))))
  56.  
  57. (define (MAIN clargs)
  58.     (if (and (= (length clargs) 3) (equal? (cadr clargs) "-display"))
  59.     (clear (caddr clargs))
  60.     (clear "")))
  61.